MacGames Sampler/PHT MacGames Bundle.iso/MacSource Folder/Samples from the CD/Editors/emacs/Emacs-1.14b1/lisp/think-c/think-ref.el

Text File | 1994-05-05 | 6.0 KB | 170 lines | [TEXT/EMAC]

;;;
;;; Code to send Apple events to Think Reference
;;;
;;; This code can run alone without the rest of the Think C suite.
;;;

(defun tc:think-ref-lookup-page (s)
  (let* (event
         (reply (make-string sizeof-AppleEvent 0))
         transactionID
         (psn (make-string (c:sizeof 'ProcessSerialNumber) 0))
         (result
          (catch 'panic
            (throw-err (GetCurrentProcess psn))
            (throw-err (ae-create-apple-event "DanR" "DanR" "REF "
                                              event transactionID))
            (throw-err (AEPutParamPtr event keyDirectObject typeChar s (length s)))
            (throw-err (AEPutParamPtr event keyProcessSerialNumber
                                      typeProcessSerialNumber psn (length psn)))
            (throw-err (tc:think-ref-send-event event reply))
            (setq ae-history (cons (cons transactionID
                                         (list (cons 'description "think-ref-page-lookup")
                                               (cons 'handler 'tc:lookup-page-reply)
                                               (cons 'key s)))
                                   ae-history))
            noErr)))

    (if event (AEDisposeDesc event))
    result))

(defun tc:lookup-page-reply (event history)
  (let* ((error-number-data (make-string 4 0))
         (returnedType (make-string 4 0))
         (actualSize (make-string 4 0))
         (err (AEGetParamPtr event keyErrorNumber typeLongInteger returnedType
                             error-number-data (length error-number-data) actualSize)))
    (if (= err errAEDescNotFound)
        noErr
      (tc:think-ref-announce-error history error-number-data)
      noErr)))

(defun tc:think-ref-announce-error (history error-number-data)
  (announce-reply history)
  (let* ((error-number (extract-internal error-number-data 0 'long))
         (key (assoc 'key history))
         (f (if key (concat "“" (cdr key) "”"))))
    (cond
     ((= error-number -1)
      (insert-reply (concat "  THINK Reference could not find the keyword"
                            (if key (concat " " f) "")
                            " in any of its databases.\n")))
     ((= error-number -2)
      (insert-reply "  THINK Reference could not find its databases.\n"))
     ((= error-number -4)
      (insert-reply (concat "  THINK Reference didn't have a template "
                            "or Inside Macintosh\n  page number for "
                            "the keyword " (if key f "") ".\n")))
     ((= error-number -5)
      (insert-reply (concat "  THINK Reference didn't have a template for the "
                            "keyword" (if key f "") ", but "
                            "it did return\n  an Inside Macintosh page number\n")))
     (t
      (insert-reply "  Error " (error-string error-number) "\n")))))

(defun tc:think-ref-copy-template (s)
  (let* (event
         (reply (make-string sizeof-AppleEvent 0))
         transactionID
         (result
          (catch 'panic
            (throw-err (ae-create-apple-event "DanR" "DanR" "TMPL"
                                              event transactionID))
            (throw-err (AEPutParamPtr event keyDirectObject typeChar s (length s)))
            (throw-err (tc:think-ref-send-event event reply))
            (setq ae-history (cons (cons transactionID
                                         (list (cons 'description "think-ref-copy-template")
                                               (cons 'handler 'tc:copy-template-reply)
                                               (cons 'key s)))
                                   ae-history))
            noErr)))

    (if event (AEDisposeDesc event))
    result))

(defun tc:copy-template-reply (event history)
  (let* ((error-number-data (make-string 4 0))
         (returnedType (make-string 4 0))
         (actualSize (make-string 4 0))
         (err (AEGetParamPtr event keyErrorNumber typeLongInteger returnedType
                             error-number-data (length error-number-data) actualSize)))
    (if (= err errAEDescNotFound)
        (let* ((result-type (make-string (c:sizeof 'long) 0))
               (result-size (make-string (c:sizeof 'long) 0))
               (err (AESizeOfParam event keyDirectObject result-type result-size)))
          (if (not (zerop err))
              err
            (let* ((actual-size (extract-internal result-size 0 'long))
                   (s (make-string actual-size 0))
                   (err (AEGetParamPtr event keyDirectObject typeChar
                                       result-type s actual-size result-size)))
              (if (not (zerop err))
                  err
                (save-excursion
                  (let ((think-ref-buf (get-buffer-create "*THINK Ref*")))
                    (set-buffer think-ref-buf)
                    (erase-buffer)
                    (insert s)
                    (kill-region (point-min) (point-max))
                    (kill-buffer think-ref-buf)))
                noErr))))
      (tc:think-ref-announce-error history error-number-data)
      noErr)))

(defun tc:think-ref-send-event (event reply)
  (let ((err (tc:think-ref-send-event-internal event reply)))
    (if (= err connectionInvalid)
        (if (y-or-n-p "Think Reference is not running.  Try to launch? ")
            (let ((launch-err (launch-application "THINK Reference")))
              (if (= launch-err fnfErr)
                  (progn
                    (message (concat "Put an alias to THINK Reference named “THINK "
                                     "Reference” in the etc folder of Emacs."))
                    noErr)
                (sleep-for 5) ;;; Let the Finder do the launch before resending
                (let ((err (tc:think-ref-send-event-internal event reply)))
                  (if (= err connectionInvalid)
                      (progn
                        (message "Couldn't launch THINK Reference")
                        noErr)
                    err))))
          noErr)
      err)))

(defun tc:think-ref-send-event-internal (event reply)
  (AESend event reply (+ kAEQueueReply kAECanInteract) kAENormalPriority 0 0 0))

(defun tc:do-think-ref-lookup-page (menu item)
  (if (not (mark))
      (message "The word to lookup should appear between point and mark.")
    (let ((err (tc:think-ref-lookup-page (buffer-substring (point) (mark)))))
      (report-error-in-message-line err))))

(defun tc:do-think-ref-copy-template (menu item)
  (let* ((s (call-interactively
             (function (lambda (x) (interactive "sTemplate to find: ") x))))
         (err (tc:think-ref-copy-template s)))
    (report-error-in-message-line err)))

(defvar tc:installed-think-ref-menu nil)

(if (not tc:installed-think-ref-menu)
    (progn
      (defvar special-menu nil)
      (defvar menu-install-hooks nil)

      (setq tc:think-ref-menu-install-hooks
            (list
             '(AppendMenu special-menu "(-" nil)
             '(AppendMenu special-menu "Find In THINK Reference/-"
                          'tc:do-think-ref-lookup-page)
             '(AppendMenu special-menu "Place Template In Kill Ring..."
                          'tc:do-think-ref-copy-template)))

      (if special-menu
          (mapcar (function eval) tc:think-ref-menu-install-hooks)
        (setq menu-install-hooks (append tc:think-ref-menu-install-hooks
                                         menu-install-hooks)))

      (setq tc:installed-think-ref-menu t)))